home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / netmail / rnr214.zip / GETFNAME.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-02  |  31KB  |  1,316 lines

  1. program getfname;
  2.  
  3. {
  4. Russell_Schulz@locutus.ofB.ORG (960202)
  5.  
  6. Copyright 1996 Russell Schulz
  7.  
  8. this code is not in the Public Domain
  9.  
  10. permission is granted to use these routines in any application regardless
  11. of commercial status as long as the author of these routines assumes no
  12. liability for any damages whatsoever for any reason.  have fun.
  13. }
  14.  
  15. uses dos,crt,genericf,linedraw;
  16.  
  17. const
  18.   esc=#27;
  19.   shiftedtab=#209;  {this is _ugly_}
  20.   altf=#210;  {this is _ugly_}
  21.   altp=#211;  {this is _ugly_}
  22.   altd=#212;  {this is _ugly_}
  23.   alto=#213;  {this is _ugly_}
  24.   altc=#214;  {this is _ugly_}
  25.  
  26. type
  27.   filenamet=string[12];  {8.3}
  28.   datetimet=string[16];  {YYYY-MM-DD HH:MM}
  29.  
  30.   filenodep=^filenode;
  31.   filenode=
  32.     record
  33.       filename: filenamet;
  34.       datetime: datetimet;
  35.       size: longint;
  36.       next: filenodep;
  37.     end;
  38.  
  39. var
  40.   outputfn: string;
  41.   title: string;
  42.   filemustexist: boolean;
  43.   maxtofind: integer;
  44.   warnifexists: boolean;
  45.   allowmkdir: boolean;
  46.   pattern: string;
  47.   currpath: string;
  48.   driveletters: string;
  49.   vikeys: boolean;
  50.  
  51.   dialogx,dialogy: integer;
  52.   dialogwidth,dialogheight: integer;
  53.  
  54.   oldtextattr: byte;
  55.  
  56.   outputf: text;
  57.   labels: array[1..26] of string;
  58.   filehead: filenodep;
  59.   pathhead: filenodep;
  60.   drivehead: filenodep;
  61.   reusehead: filenodep;
  62.  
  63.   titlwithpath: string;
  64.   resultingfn: string;
  65.  
  66.   underdialog: savedbytes;
  67.  
  68.   startupx,startupy: integer;
  69.  
  70. procedure usage;
  71.  
  72. begin
  73.   writeln('usage:  getfname [options] required');
  74.   writeln;
  75.   writeln('required:');
  76.   writeln('  -o output-filename');
  77.   writeln;
  78.   writeln('options:');
  79.   writeln('  -t title');
  80.   writeln('  -e file must exist');
  81.   writeln('  -m maximum # of files to return (now can only be 1)');
  82.   writeln('  -w warn if it exists');
  83.   writeln('  -i initial pattern');
  84.   writeln('  -n don''t allow mkdir');
  85.   writeln('  -p path to start in');
  86.   writeln('  -d drive letters to check (e.g., CDZ)');
  87.   writeln('  -v use vi keys (j and k; but not ^F and ^B, sorry)');
  88.   writeln;
  89.   writeln('Russell_Schulz@locutus.ofB.ORG (960202)');
  90.   halt(1);
  91. end;
  92.  
  93. procedure msgusage(s: string);
  94.  
  95. begin
  96.   writeln(s);
  97.   usage;
  98. end;
  99.  
  100. function withzero(i: integer): string;
  101.  
  102. begin
  103.   withzero := chr(ord('0')+(i div 10))+chr(ord('0')+(i mod 10));
  104. end;
  105.  
  106. function withoutlastdir(apath: string): string;
  107.  
  108. var
  109.   result: string;
  110.   newlength: integer;
  111.   tempint: integer;
  112.  
  113. begin
  114.   result := apath;
  115.  
  116.   if numoccur('\',withbackslash(result))>1 then
  117.     begin
  118.       newlength := length(result);  {not needed}
  119.  
  120.       for tempint := 1 to length(result) do
  121.         if result[tempint]='\' then
  122.           newlength := tempint-1;
  123.  
  124.       result := copy(result,1,newlength);
  125.       if right(result,1)=':' then
  126.         result := result+'\';
  127.     end;
  128.  
  129. {
  130.   if right(result,1)='\' then
  131.     if length(result)>1 then
  132.       if right(result,2)<>':\' then
  133.         result := copy(result,1,length(result)-1);
  134. }
  135.  
  136.   withoutlastdir := result;
  137. end;
  138.  
  139. function unlabel(labelfn: string): string;
  140.  
  141. begin
  142.   unlabel := copy(labelfn,1,8)+copy(labelfn,10,255);  {skip the implied .}
  143. end;
  144.  
  145. function prevptr(aptr: filenodep; ahead: filenodep): filenodep;
  146.  
  147. var
  148.   result: filenodep;
  149.   found: boolean;
  150.  
  151. begin
  152.   result := ahead;
  153.   found := false;
  154.  
  155.   while (result<>nil) and not found do
  156.     begin
  157.       if result^.next=aptr then
  158.         found := true
  159.       else
  160.         result := result^.next;
  161.     end;
  162.  
  163. {
  164.   if not found then
  165.     writeln('internal error:  could not find prev');
  166. }
  167.  
  168.   prevptr := result;
  169. end;
  170.  
  171. procedure sortlist(var ahead: filenodep);
  172.  
  173. var
  174.   newhead: filenodep;
  175.   lastsofar: filenodep;
  176.   lastnamesofar: filenamet;
  177.   prevtolast: filenodep;
  178.   current: filenodep;
  179.  
  180. begin
  181.   newhead := nil;
  182.  
  183.   while ahead<>nil do
  184.     begin
  185.       lastsofar := ahead;
  186.       lastnamesofar := ahead^.filename;
  187.  
  188.       current := lastsofar^.next;
  189.       while current<>nil do
  190.         begin
  191.           if current^.filename>lastnamesofar then
  192.             begin
  193.               lastsofar := current;
  194.               lastnamesofar := current^.filename;
  195.             end;
  196.  
  197.           current := current^.next;
  198.         end;
  199.  
  200. {remove from list}
  201.       if lastsofar=ahead then
  202.         ahead := ahead^.next
  203.       else
  204.         begin
  205.           prevtolast := prevptr(lastsofar,ahead);
  206.           prevtolast^.next := lastsofar^.next;
  207.         end;
  208.  
  209. {add to new head}
  210.       lastsofar^.next := newhead;
  211.       newhead := lastsofar;
  212.     end;
  213.  
  214.   ahead := newhead;
  215. end;
  216.  
  217. procedure reversevideo;
  218.  
  219. begin
  220.   textattr := black+white*8;
  221. {
  222.   textcolor(red);
  223. }
  224. end;
  225.  
  226. procedure enhancedvideo;
  227.  
  228. begin
  229.   textattr := blue;
  230. {
  231.   textcolor(blue);
  232. }
  233. end;
  234.  
  235. procedure normalvideo;
  236.  
  237. begin
  238.   textattr := oldtextattr;
  239. {
  240.   textcolor(white);
  241. }
  242. end;
  243.  
  244. procedure reuse(var ahead: filenodep);
  245.  
  246. var
  247.   aptr: filenodep;
  248.  
  249. begin
  250.   if reusehead=nil then
  251.     reusehead := ahead
  252.   else
  253.     begin
  254.       aptr := reusehead;
  255.       while aptr^.next<>nil do
  256.         aptr := aptr^.next;
  257.       aptr^.next := ahead;
  258.     end;
  259.  
  260.   ahead := nil;
  261. end;
  262.  
  263. function xreadkey: char;
  264.  
  265. var
  266.   result: char;
  267.  
  268. begin
  269.   result := readkey;
  270.  
  271. {$define pgdnbecomesgt}
  272.  
  273. { change these extended keys: }
  274.  
  275. {    2nd Char key pressed    code returned       }
  276. {    -------- -----------    -------------       }
  277. {    I  73    PgUp           <                   }
  278. {    Q  81    PgDn           space (or >)        }
  279. {    G  71    Home           ^A (or ^)           }
  280. {    O  79    End            ^E (or $)           }
  281. {    ;  59    F1             ?                   }
  282. {    K  75    left arrow     ^B (or backspace)   }
  283. {    M  77    right arrow    ^F                  }
  284. {    H  72    up arrow       ^P                  }
  285. {    P  80    down arrow     ^N                  }
  286. {    S  83    del            ^D                  }
  287. {       15    shift-TAB      shiftedtab (209)    }
  288.  
  289. {       misc  alt-letter     misc. codes >209    }
  290.  
  291.  
  292.   if (result=#0) and keypressed then
  293.     begin
  294.       result := readkey;
  295.  
  296.       if result='I' then
  297.         result := '<'
  298.       else if result='Q' then
  299. {$ifdef pgdnbecomesgt}
  300.         result := '>'
  301. {$else}
  302.         result := ' '
  303. {$endif}
  304.       else if result='G' then
  305. {$ifdef homebecomescarat}
  306.         result := '^'
  307. {$else}
  308.         result := ^A
  309. {$endif}
  310.       else if result='O' then
  311. {$ifdef endbecomesdollar}
  312.         result := '$'
  313. {$else}
  314.         result := ^E
  315. {$endif}
  316.       else if result=';' then
  317.         result := '?'
  318.       else if result='K' then
  319. {$ifdef leftbecomesbackspace}
  320.         result := #8
  321. {$else}
  322.         result := ^B
  323. {$endif}
  324.       else if result='M' then
  325.         result := ^F
  326.       else if result='H' then
  327.         result := ^P
  328.       else if result='P' then
  329.         result := ^N
  330.       else if result='S' then
  331.         result := ^D
  332.       else if result=#15 then
  333.         result := shiftedtab
  334.  
  335.       else if result=#33 then
  336.         result := altf
  337.       else if result=#25 then
  338.         result := altp
  339.       else if result=#32 then
  340.         result := altd
  341.       else if result=#24 then
  342.         result := alto
  343.       else if result=#46 then
  344.         result := altc
  345.  
  346.       else
  347.  
  348. { ignore other extended keys }
  349.  
  350.         result := #0;
  351.     end;
  352.  
  353.   xreadkey := result;
  354. end;
  355.  
  356. procedure initialize;
  357.  
  358. var
  359.   currparami: integer;
  360.   currparams: string;
  361.   nextparams: string;
  362.  
  363. begin
  364.   oldtextattr := textattr;
  365.  
  366.   startupx := wherex;
  367.   startupy := wherey;
  368.  
  369.   if paramcount=0 then
  370.     usage;
  371.  
  372.   outputfn := '';
  373.   title := 'Open';
  374.  
  375.   filemustexist := false;
  376.   maxtofind := 1;
  377.   warnifexists := false;
  378.   allowmkdir := true;
  379.   pattern := '*.*';
  380.   currpath := '';
  381. { driveletters := 'abcdefghijklmnopqrstuvwxyz'; }
  382.   driveletters :=   'cdefghijklmnopqrstuvwxyz';
  383.   vikeys := false;
  384.  
  385.   dialogx := 2;
  386.   dialogy := 2;
  387.   dialogwidth := 74;
  388.   dialogheight := 20;
  389.  
  390.   currparami := 1;
  391.   while currparami<=paramcount do
  392.     begin
  393.       currparams := paramstr(currparami);
  394.       if currparami<paramcount then
  395.         nextparams := paramstr(currparami+1)
  396.       else
  397.         nextparams := '';
  398.  
  399.       if currparams='-?' then
  400.         usage
  401.       else if currparams='-o' then
  402.         begin
  403.           if nextparams='' then
  404.             msgusage('-o requires a filename');
  405.           outputfn := nextparams;
  406.           inc(currparami);
  407.         end
  408.       else if currparams='-t' then
  409.         begin
  410.           if nextparams='' then
  411.             msgusage('-t requires a string');
  412.           title := nextparams;
  413.           inc(currparami);
  414.         end
  415.       else if currparams='-e' then
  416.         begin
  417.           filemustexist := true;
  418.         end
  419.       else if currparams='-m' then
  420.         begin
  421.           if nextparams='' then
  422.             msgusage('-m requires an integer');
  423.           maxtofind := atoi(nextparams);
  424.           if maxtofind=0 then
  425.             msgusage('-m requires an integer');
  426.           inc(currparami);
  427.         end
  428.       else if currparams='-w' then
  429.         begin
  430.           warnifexists := true;
  431.         end
  432.       else if currparams='-n' then
  433.         begin
  434.           allowmkdir := false;
  435.         end
  436.       else if currparams='-i' then
  437.         begin
  438.           if nextparams='' then
  439.             msgusage('-i requires a pattern');
  440.           pattern := nextparams;
  441.           inc(currparami);
  442.         end
  443.       else if currparams='-p' then
  444.         begin
  445.           if nextparams='' then
  446.             msgusage('-p requires a path');
  447.           currpath := nextparams;
  448.           inc(currparami);
  449.         end
  450.       else if currparams='-d' then
  451.         begin
  452.           if nextparams='' then
  453.             msgusage('-d requires a list of letters');
  454.           driveletters := nextparams;
  455.           inc(currparami);
  456.         end
  457.       else if currparams='-v' then
  458.         begin
  459.           vikeys := true;
  460.         end
  461.       else
  462.         msgusage('unknown parameter: '+currparams);
  463.  
  464.       inc(currparami);
  465.     end;
  466.  
  467.   if outputfn='' then
  468.     msgusage('-o is required');
  469.  
  470.   if currpath='' then
  471.     begin
  472.       {set path to current}
  473.       getdir(0,currpath);
  474.       currpath := lower(currpath);
  475.     end;
  476.  
  477.   if right(currpath,1)=':' then
  478.     begin
  479.       {set path to current}
  480.       getdir(1+ord(upcase(currpath[1]))-ord('A'),currpath);
  481.       currpath := lower(currpath);
  482.     end;
  483.  
  484.   assign(outputf,outputfn);
  485. {$I-}
  486.   rewrite(outputf);
  487. {$I+}
  488.   if ioresult<>0 then
  489.     msgusage('could not write to '+outputfn);
  490.  
  491.   resultingfn := '';
  492.  
  493.   reusehead := nil;
  494. end;
  495.  
  496. function getnewptr: filenodep;
  497.  
  498. var
  499.   result: filenodep;
  500.  
  501. begin
  502.   if reusehead<>nil then
  503.     begin
  504.       result := reusehead;
  505.       reusehead := reusehead^.next;
  506.     end
  507.   else
  508.     begin
  509.       if memavail<10240 then
  510.         result := nil
  511.       else
  512.         new(result);
  513.     end;
  514.  
  515.   getnewptr := result;
  516. end;
  517.  
  518. function longintdatetostring(time: longint): string;
  519.  
  520. var
  521.   result: string;
  522.   dt: datetime;
  523.  
  524. begin
  525.   unpacktime(time,dt);
  526.   result := wtoa(dt.year)+'-'+withzero(dt.month)+'-'+withzero(dt.day)+' '+
  527.    withzero(dt.hour)+':'+withzero(dt.min);
  528.   longintdatetostring := result;
  529. end;
  530.  
  531. function insertedptrathead(var ahead: filenodep; filename: string;
  532.  datetime: string; size: longint): boolean;
  533.  
  534. var
  535.   result: boolean;
  536.   newptr: filenodep;
  537.  
  538. begin
  539.   result := true;
  540.  
  541.   newptr := getnewptr;
  542.   if newptr=nil then
  543.     begin
  544.       result := false;
  545. {}{}{}{}{} {need to handle out-of-memory better than this}
  546.       gotoxy(1,1);
  547.       writeln('out of memory');
  548.     end
  549.   else
  550.     begin
  551.       newptr^.next := ahead;
  552.       ahead := newptr;
  553.       newptr^.filename := filename;
  554.       newptr^.datetime := datetime;
  555.       newptr^.size := size;
  556.     end;
  557.  
  558.   insertedptrathead := result;
  559. end;
  560.  
  561. procedure initializedir;
  562.  
  563. var
  564.   fileinfo: searchrec;
  565.   done: boolean;
  566.  
  567. begin
  568.   staticpopup(10,10,'Searching directory...');
  569.  
  570.   reuse(filehead);
  571.   reuse(pathhead);
  572.  
  573.   findfirst(withbackslash(currpath)+pattern,directory,fileinfo);
  574.   done := (doserror<>0);
  575.   while not done do
  576.     begin
  577.       if (fileinfo.attr and directory)=0 then
  578.         begin
  579.           done := not
  580.            insertedptrathead(filehead,
  581.             lower(fileinfo.name),
  582.             longintdatetostring(fileinfo.time),
  583.             fileinfo.size);
  584.         end
  585.       else
  586.         begin
  587.           if (fileinfo.name<>'.') and (fileinfo.name<>'..') then
  588.             done :=
  589.              not insertedptrathead(pathhead,lower(fileinfo.name),'',0);
  590.         end;
  591.  
  592.       if not done then
  593.         begin
  594.           findnext(fileinfo);
  595.           done := (doserror<>0);
  596.         end;
  597.     end;
  598.  
  599.   sortlist(filehead);
  600.   sortlist(pathhead);
  601.  
  602. {
  603.   need to add it in by hand since our Netware 4.1 drive doesn't
  604.   list . or .. (I don't know why!)
  605. }
  606.   if right(currpath,2)<>':\' then
  607.     begin
  608. {just assign to `done' -- not used}
  609.       done := not insertedptrathead(pathhead,'..','',0);
  610.     end;
  611.  
  612.   removepopup;
  613. end;
  614.  
  615. procedure initializedrivelist;
  616.  
  617. var
  618.   whichdisk: integer;
  619.   done: boolean;
  620.   fileinfo: searchrec;
  621.  
  622. begin
  623.   staticpopup(10,10,'Finding valid drives...');
  624.  
  625.   reuse(drivehead);
  626.  
  627.   done := false;
  628.   for whichdisk := 26 downto 1 do
  629.     begin
  630.       labels[whichdisk] := '';
  631.       if not done then
  632.         if pos(chr(ord('A')+whichdisk-1),upper(driveletters))<>0 then
  633.           if diskfree(whichdisk)>=0 then
  634.             begin
  635.               labels[whichdisk] := chr(ord('A')+whichdisk-1)+':';
  636.               findfirst(labels[whichdisk]+'\*.*',volumeid,fileinfo);
  637.               if doserror=0 then
  638.                 labels[whichdisk] :=
  639.                  labels[whichdisk]+' '+lower(unlabel(fileinfo.name));
  640.  
  641.               done := not
  642.                insertedptrathead(drivehead,
  643.                 labels[whichdisk],
  644.                 '',
  645.                 diskfree(whichdisk));
  646.           end;
  647.     end;
  648.  
  649.   removepopup;
  650. end;
  651.  
  652. {$ifdef old}
  653. procedure saveunderdialog;
  654.  
  655. var
  656.   anx,any: integer;
  657.   regs: registers;
  658.  
  659. begin
  660.   underdialog.count := 0;
  661.  
  662.   for anx := dialogx to dialogx+dialogwidth-1 do
  663.     for any := dialogy to dialogy+dialogheight-1 do
  664.       if underdialog.count<maxsavedbytes-1 then
  665.         begin
  666.           gotoxy(anx,any);
  667.  
  668. {read character+attribute from screen}
  669.           regs.ah := 8;
  670.           regs.bh := 0;
  671.           intr($10,regs);
  672.  
  673. {first character, then attribute}
  674.           inc(underdialog.count);
  675.           underdialog.buffer[underdialog.count] := chr(regs.al);
  676.           inc(underdialog.count);
  677.           underdialog.buffer[underdialog.count] := chr(regs.ah);
  678.         end;
  679. end;
  680.  
  681. procedure restoreunderdialog;
  682.  
  683. var
  684.   anx,any: integer;
  685.   currbyte: integer;
  686.   regs: registers;
  687.  
  688. begin
  689.   currbyte := 0;
  690.   for anx := dialogx to dialogx+dialogwidth-1 do
  691.     for any := dialogy to dialogy+dialogheight-1 do
  692.       if currbyte<underdialog.count then
  693.         begin
  694.           gotoxy(anx,any);
  695.  
  696. {first character, then attribute}
  697.           inc(currbyte);
  698.           regs.al := ord(underdialog.buffer[currbyte]);
  699.           inc(currbyte);
  700.           regs.bl := ord(underdialog.buffer[currbyte]);
  701.  
  702. {write character+attribute to screen}
  703.           regs.ah := 9;
  704.           regs.bh := 0;
  705.           regs.cx := 1;
  706.           intr($10,regs);
  707.  
  708.         end;
  709. end;
  710. {$endif}
  711.  
  712. procedure updatedialogtitle(newpath: string);
  713.  
  714. var
  715.   titlewithpath: string;
  716.  
  717. begin
  718.   singleboxwh(dialogx,dialogy,dialogwidth,dialogheight);
  719.  
  720.   titlewithpath := title+' - '+newpath;
  721.   writexys(dialogx+1,dialogy,titlewithpath);
  722. end;
  723.  
  724. procedure displaydialogoutline;
  725.  
  726. begin
  727.   singleboxwh(dialogx,dialogy,dialogwidth,dialogheight);
  728.   emptyboxwh(dialogx,dialogy,dialogwidth,dialogheight);
  729.  
  730. {
  731.   writexys(dialogx+1,dialogy,title);
  732.   updatedialogtitle(title);
  733. }
  734. end;
  735.  
  736. procedure fancyboxwh(isfancy: boolean; leftx,topy,width,height: integer);
  737.  
  738. begin
  739.   if isfancy then
  740.     begin
  741.       enhancedvideo;
  742.       doubleboxwh(leftx,topy,width,height);
  743.       normalvideo;
  744.     end
  745.   else
  746.     begin
  747.       normalvideo;
  748.       singleboxwh(leftx,topy,width,height);
  749.       normalvideo;
  750.     end;
  751. end;
  752.  
  753. procedure displayfilepartoutline(isselected: boolean);
  754.  
  755. begin
  756.   if isselected then
  757.     doubleboxwh(dialogx+1,dialogy+1,44,dialogheight-2)
  758.   else
  759.     singleboxwh(dialogx+1,dialogy+1,44,dialogheight-2);
  760.  
  761.   writexys(dialogx+2,dialogy+1,'File');
  762. end;
  763.  
  764. procedure displaypathpartoutline(isselected: boolean);
  765.  
  766. begin
  767.   if isselected then
  768.     doubleboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10)
  769.   else
  770.     singleboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10);
  771.  
  772.   writexys(dialogx+46,dialogy+1,'Path');
  773. end;
  774.  
  775. procedure displaydrivepartoutline(isselected: boolean);
  776.  
  777. begin
  778.   if isselected then
  779.     doubleboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2)
  780.   else
  781.     singleboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2);
  782.  
  783.   writexys(dialogx+46,dialogy+10+1,'Drive');
  784. end;
  785.  
  786. procedure displayokoutline(isselected: boolean);
  787.  
  788. begin
  789.   if isselected then
  790.     doubleboxwh(dialogx+45,dialogy+dialogheight-3,10,2)
  791.   else
  792.     singleboxwh(dialogx+45,dialogy+dialogheight-3,10,2);
  793.  
  794.   writexys(dialogx+46,dialogy+dialogheight-3,'OK');
  795. end;
  796.  
  797. procedure displaycanceloutline(isselected: boolean);
  798.  
  799. begin
  800.   if isselected then
  801.     doubleboxwh(dialogx+55,dialogy+dialogheight-3,10,2)
  802.   else
  803.     singleboxwh(dialogx+55,dialogy+dialogheight-3,10,2);
  804.  
  805.   writexys(dialogx+56,dialogy+dialogheight-3,'Cancel');
  806. end;
  807.  
  808. procedure updatefilepart(startptr: filenodep);
  809.  
  810. var
  811.   aptr: filenodep;
  812.   curry: integer;
  813.  
  814. begin
  815.   emptyboxwh(dialogx+1,dialogy+1,44,dialogheight-2);
  816.  
  817.   curry := dialogy+2;
  818.   aptr := startptr;
  819.   while (aptr<>nil) and (curry<dialogy+dialogheight-2) do
  820.     begin
  821.       if aptr=startptr then
  822.         reversevideo;
  823.       writexys(dialogx+3,curry,leftjustify(aptr^.filename,12,' '));
  824.       write(' ',aptr^.datetime);
  825.       write(' ',rightjustify(ltoa(aptr^.size div 1024),9,' '),'k');
  826.       normalvideo;
  827.  
  828.       aptr := aptr^.next;
  829.       inc(curry);
  830.     end;
  831.  
  832. {
  833.   gotoxy(dialogx+2,dialogy+2);
  834. }
  835. end;
  836.  
  837. procedure updatepathpart(startptr: filenodep);
  838.  
  839. var
  840.   aptr: filenodep;
  841.   curry: integer;
  842. {
  843.   mangledcurrpath: string;
  844.   partofpath: string;
  845. }
  846.  
  847. begin
  848.   emptyboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10);
  849.  
  850.   curry := dialogy+2;
  851.  
  852. {
  853.   mangledcurrpath := withbackslash(currpath);
  854.   while (mangledcurrpath<>'') and (curry<dialogy+10) do
  855.     begin
  856.       partofpath := copy(mangledcurrpath,1,pos('\',mangledcurrpath));
  857.       mangledcurrpath := copy(mangledcurrpath,length(partofpath)+1,255);
  858.       writexys(dialogx+45+2,curry,leftjustify(partofpath,12,' '));
  859.       inc(curry);
  860.     end;
  861. }
  862.  
  863.   aptr := startptr;
  864.   while (aptr<>nil) and (curry<dialogy+10) do
  865.     begin
  866. {}{}{}{} {want to show the tree so far non-indented}
  867.  
  868.       if aptr=startptr then
  869.         reversevideo;
  870. {indent 3}
  871.       writexys(dialogx+45+2+3,curry,leftjustify(aptr^.filename,12,' '));
  872. {
  873.       write(' ',aptr^.datetime);
  874.       write(' ',rightjustify(ltoa(aptr^.size div 1024),9,' '),'k');
  875. }
  876.       normalvideo;
  877.  
  878.       aptr := aptr^.next;
  879.       inc(curry);
  880.     end;
  881.  
  882. {
  883.   gotoxy(dialogx+45+1,dialogy+1+1);
  884. }
  885. end;
  886.  
  887. procedure updatedrivepart(startptr: filenodep);
  888.  
  889. var
  890.   aptr: filenodep;
  891.   curry: integer;
  892.  
  893. begin
  894.   emptyboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2);
  895.  
  896.   curry := dialogy+10+2;
  897.   aptr := startptr;
  898.   while (aptr<>nil) and (curry<dialogy+dialogheight-2-1-1) do
  899.     begin
  900.       if aptr=startptr then
  901.         reversevideo;
  902.       writexys(dialogx+46,curry,leftjustify(aptr^.filename,12,' '));
  903. {
  904.       write(' ',aptr^.datetime);
  905. }
  906.       write(' ',
  907.        rightjustify(ltoa((aptr^.size+1024*1024-1) div 1024 div 1024),9,' '),
  908.        'M');
  909.       normalvideo;
  910.  
  911.       aptr := aptr^.next;
  912.       inc(curry);
  913.     end;
  914.  
  915. {
  916.   gotoxy(dialogx+2,dialogy+2);
  917. }
  918. end;
  919.  
  920. procedure maybeincptr(var aptr: filenodep; count: integer);
  921.  
  922. var
  923.   tempint: integer;
  924.  
  925. begin
  926.   for tempint := 1 to count do
  927.     if aptr^.next<>nil then
  928.       aptr := aptr^.next;
  929. end;
  930.  
  931. procedure maybedecptr(var aptr: filenodep; ahead: filenodep; count: integer);
  932.  
  933. var
  934.   tempint: integer;
  935.  
  936. begin
  937.   for tempint := 1 to count do
  938.     if prevptr(aptr,ahead)<>nil then
  939.       aptr := prevptr(aptr,ahead);
  940. end;
  941.  
  942. procedure process;
  943.  
  944. type
  945.   showingt=
  946.    (
  947.    onfirst,
  948.      onfilepart,
  949.      onpathpart,
  950.      ondrivepart,
  951.      onok,
  952.      oncancel,
  953.    onlast
  954.    );
  955.  
  956. var
  957.   currfileptr: filenodep;
  958.   currpathptr: filenodep;
  959.   currdriveptr: filenodep;
  960.   done: boolean;
  961.   onekey: char;
  962.   showing: showingt;
  963.  
  964. begin
  965.   drivehead := nil;
  966.   initializedrivelist;
  967.  
  968.   saveareawh(dialogx,dialogy,dialogwidth,dialogheight,underdialog);
  969.  
  970.   displaydialogoutline;
  971.  
  972.   showing := onfilepart;
  973.  
  974.   displayfilepartoutline(showing=onfilepart);
  975.   displaypathpartoutline(showing=onpathpart);
  976.   displaydrivepartoutline(showing=ondrivepart);
  977.   displayokoutline(showing=onok);
  978.   displaycanceloutline(showing=oncancel);
  979.  
  980.   filehead := nil;
  981.   pathhead := nil;
  982.  
  983.   initializedir;
  984.  
  985.   currfileptr := filehead;
  986.   currpathptr := pathhead;
  987.   currdriveptr := drivehead;
  988.  
  989.   updatefilepart(currfileptr);
  990.   updatepathpart(currpathptr);
  991.   updatedrivepart(currdriveptr);
  992.  
  993.   updatedialogtitle(currpath);
  994.  
  995.   done := false;
  996.   while not done do
  997.     begin
  998.       case showing of
  999.         onfilepart: updatefilepart(currfileptr);
  1000.         onpathpart: updatepathpart(currpathptr);
  1001.         ondrivepart: updatedrivepart(currdriveptr);
  1002.       else
  1003.         begin end;
  1004.       end;
  1005.  
  1006.       onekey := xreadkey;
  1007.  
  1008.       if onekey=tab then
  1009.         begin
  1010.           showing := succ(showing);
  1011.           if showing=onlast then
  1012.             showing := succ(onfirst);
  1013.  
  1014.           displayfilepartoutline(showing=onfilepart);
  1015.           displaypathpartoutline(showing=onpathpart);
  1016.           displaydrivepartoutline(showing=ondrivepart);
  1017.           displayokoutline(showing=onok);
  1018.           displaycanceloutline(showing=oncancel);
  1019.         end
  1020.       else if onekey=shiftedtab then
  1021.         begin
  1022.           showing := pred(showing);
  1023.           if showing=onfirst then
  1024.             showing := pred(onlast);
  1025.  
  1026.           displayfilepartoutline(showing=onfilepart);
  1027.           displaypathpartoutline(showing=onpathpart);
  1028.           displaydrivepartoutline(showing=ondrivepart);
  1029.           displayokoutline(showing=onok);
  1030.           displaycanceloutline(showing=oncancel);
  1031.         end
  1032.       else if onekey=altf then
  1033.         begin
  1034.           showing := onfilepart;
  1035.  
  1036.           displayfilepartoutline(showing=onfilepart);
  1037.           displaypathpartoutline(showing=onpathpart);
  1038.           displaydrivepartoutline(showing=ondrivepart);
  1039.           displayokoutline(showing=onok);
  1040.           displaycanceloutline(showing=oncancel);
  1041.         end
  1042.       else if onekey=altp then
  1043.         begin
  1044.           showing := onpathpart;
  1045.  
  1046.           displayfilepartoutline(showing=onfilepart);
  1047.           displaypathpartoutline(showing=onpathpart);
  1048.           displaydrivepartoutline(showing=ondrivepart);
  1049.           displayokoutline(showing=onok);
  1050.           displaycanceloutline(showing=oncancel);
  1051.         end
  1052.       else if onekey=altd then
  1053.         begin
  1054.           showing := ondrivepart;
  1055.  
  1056.           displayfilepartoutline(showing=onfilepart);
  1057.           displaypathpartoutline(showing=onpathpart);
  1058.           displaydrivepartoutline(showing=ondrivepart);
  1059.           displayokoutline(showing=onok);
  1060.           displaycanceloutline(showing=oncancel);
  1061.         end
  1062.       else if onekey=alto then
  1063.         begin
  1064. {}{}{}{} {they might have typed in a new filename}
  1065.           resultingfn := withbackslash(currpath)+currfileptr^.filename;
  1066.           done := true
  1067.         end
  1068.       else if onekey=altc then
  1069.         begin
  1070.           done := true;
  1071.         end
  1072.       else if onekey=esc then
  1073.         begin
  1074.           done := true;
  1075.         end
  1076.       else
  1077.         case showing of
  1078.  
  1079.           onfilepart:
  1080.             begin
  1081.               if onekey=#13 then
  1082.                 begin
  1083.                   if currfileptr<>nil then
  1084.                     begin
  1085. {}{}{}{} {they might have typed in a new filename}
  1086.                       resultingfn :=
  1087.                        withbackslash(currpath)+currfileptr^.filename;
  1088.                       done := true
  1089.                     end;
  1090.                 end
  1091.               else if onekey=^N then
  1092.                 begin
  1093.                   maybeincptr(currfileptr,1);
  1094.                 end
  1095.               else if vikeys and (onekey='j') then
  1096.                 begin
  1097.                   maybeincptr(currfileptr,1);
  1098.                 end
  1099.               else if onekey=^P then
  1100.                 begin
  1101.                   maybedecptr(currfileptr,filehead,1);
  1102.                 end
  1103.               else if vikeys and (onekey='k') then
  1104.                 begin
  1105.                   maybedecptr(currfileptr,filehead,1);
  1106.                 end
  1107.               else if onekey='>' then
  1108.                 begin
  1109.                   maybeincptr(currfileptr,15);
  1110.                 end
  1111.               else if onekey='<' then
  1112.                 begin
  1113.                   maybedecptr(currfileptr,filehead,15);
  1114.                 end
  1115.               else if onekey=^E then
  1116.                 begin
  1117.                   while currfileptr^.next<>nil do
  1118.                     currfileptr := currfileptr^.next;
  1119.                 end
  1120.               else if onekey=^A then
  1121.                 begin
  1122.                   currfileptr := filehead;
  1123.                 end
  1124.               else
  1125.                 begin
  1126.                   {}
  1127.                 end;
  1128.             end;
  1129.  
  1130.           onpathpart:
  1131.             begin
  1132.               if onekey=#13 then
  1133.                 begin
  1134.                   if currpathptr<>nil then
  1135.                     begin
  1136.                       if currpathptr^.filename='..' then
  1137.                         currpath := withoutlastdir(currpath)
  1138.                       else
  1139.                         currpath :=
  1140.                          withbackslash(currpath)+currpathptr^.filename;
  1141.  
  1142.                       initializedir;
  1143.                       currfileptr := filehead;
  1144.                       currpathptr := pathhead;
  1145.                       updatefilepart(currfileptr);
  1146.                       updatepathpart(currpathptr);
  1147.  
  1148.                       updatedialogtitle(currpath);
  1149.                     end;
  1150.                 end
  1151.               else if onekey=^N then
  1152.                 begin
  1153.                   maybeincptr(currpathptr,1);
  1154.                 end
  1155.               else if vikeys and (onekey='j') then
  1156.                 begin
  1157.                   maybeincptr(currpathptr,1);
  1158.                 end
  1159.               else if onekey=^P then
  1160.                 begin
  1161.                   maybedecptr(currpathptr,pathhead,1);
  1162.                 end
  1163.               else if vikeys and (onekey='k') then
  1164.                 begin
  1165.                   maybedecptr(currpathptr,pathhead,1);
  1166.                 end
  1167.               else if onekey='>' then
  1168.                 begin
  1169.                   maybeincptr(currpathptr,7);
  1170.                 end
  1171.               else if onekey='<' then
  1172.                 begin
  1173.                   maybedecptr(currpathptr,pathhead,7);
  1174.                 end
  1175.               else if onekey=^E then
  1176.                 begin
  1177.                   while currpathptr^.next<>nil do
  1178.                     currpathptr := currpathptr^.next;
  1179.                 end
  1180.               else if onekey=^A then
  1181.                 begin
  1182.                   currpathptr := pathhead;
  1183.                 end
  1184.               else
  1185.                 begin
  1186.                   {}
  1187.                 end;
  1188.             end;
  1189.  
  1190.           ondrivepart:
  1191.             begin
  1192.               if onekey=#13 then
  1193.                 begin
  1194.                   if currdriveptr<>nil then
  1195.                     begin
  1196.                       getdir(1+ord(upcase(currdriveptr^.filename[1]))-ord('A'),
  1197.                        currpath);
  1198.                       currpath := lower(currpath);
  1199.  
  1200.                       initializedir;
  1201.  
  1202.                       currfileptr := filehead;
  1203.                       currpathptr := pathhead;
  1204.  
  1205.                       updatefilepart(currfileptr);
  1206.                       updatepathpart(currpathptr);
  1207.                       updatedrivepart(currdriveptr);
  1208.  
  1209.                       updatedialogtitle(currpath);
  1210.                     end;
  1211.                 end
  1212.               else if onekey=^N then
  1213.                 begin
  1214.                   maybeincptr(currdriveptr,1);
  1215.                 end
  1216.               else if vikeys and (onekey='j') then
  1217.                 begin
  1218.                   maybeincptr(currdriveptr,1);
  1219.                 end
  1220.               else if onekey=^P then
  1221.                 begin
  1222.                   maybedecptr(currdriveptr,drivehead,1);
  1223.                 end
  1224.               else if vikeys and (onekey='k') then
  1225.                 begin
  1226.                   maybedecptr(currdriveptr,drivehead,1);
  1227.                 end
  1228.               else if onekey='>' then
  1229.                 begin
  1230.                   maybeincptr(currdriveptr,3);
  1231.                 end
  1232.               else if onekey='<' then
  1233.                 begin
  1234.                   maybedecptr(currdriveptr,drivehead,3);
  1235.                 end
  1236.               else if onekey=^E then
  1237.                 begin
  1238.                   while currdriveptr^.next<>nil do
  1239.                     currdriveptr := currdriveptr^.next;
  1240.                 end
  1241.               else if onekey=^A then
  1242.                 begin
  1243.                   currdriveptr := drivehead;
  1244.                 end
  1245.               else
  1246.                 begin
  1247.                   {}
  1248.                 end;
  1249.             end;
  1250.  
  1251.           onok:
  1252.             begin
  1253.               if onekey=#13 then
  1254.                 begin
  1255.                   if currfileptr<>nil then
  1256.                     begin
  1257. {}{}{}{} {they might have typed in a new filename}
  1258.                       resultingfn :=
  1259.                        withbackslash(currpath)+currfileptr^.filename;
  1260.                       done := true;
  1261.                     end;
  1262.                 end
  1263.               else if onekey=' ' then
  1264.                 begin
  1265.                   if currfileptr<>nil then
  1266.                     begin
  1267. {}{}{}{} {they might have typed in a new filename}
  1268.                       resultingfn :=
  1269.                        withbackslash(currpath)+currfileptr^.filename;
  1270.                       done := true;
  1271.                     end;
  1272.                 end
  1273.               else
  1274.                 begin
  1275.                   {}
  1276.                 end;
  1277.             end;
  1278.  
  1279.           oncancel:
  1280.             begin
  1281.               if onekey=#13 then
  1282.                 begin
  1283.                   done := true;
  1284.                 end
  1285.               else if onekey=' ' then
  1286.                 begin
  1287.                   done := true;
  1288.                 end
  1289.               else
  1290.                 begin
  1291.                   {}
  1292.                 end;
  1293.             end;
  1294.         end;
  1295.     end;
  1296.  
  1297.   restorearea(underdialog);
  1298. end;
  1299.  
  1300. procedure shutdown;
  1301.  
  1302. begin
  1303.   if resultingfn<>'' then
  1304.     writeln(outputf,resultingfn);
  1305.   close(outputf);
  1306.  
  1307.   gotoxy(startupx,startupy);
  1308.   textattr := oldtextattr;
  1309. end;
  1310.  
  1311. begin
  1312.   initialize;
  1313.   process;
  1314.   shutdown;
  1315. end.
  1316.